pragma Ada_2012;
-- with Ada.Text_IO;
package body Storage_Streams.Unbounded is

   function "<" (left, right : Stream_Cursor_Type) return Boolean
   is
      pragma Inline ("<");
   begin
      return left.Block < right.Block or else (
         left.Block = right.Block and then left.Index < right.Index);
   end "<";

   function ">" (left, right : Stream_Cursor_Type) return Boolean
   is
      pragma Inline (">");
   begin
      return right < left;
   end ">";

   function Image (c : Stream_Cursor_Type) return String
   is
   begin
      return "(block =>" & c.Block'Img & ", index =>" & c.Index'Img & ")";
   end Image;

   function Next (
      this : Unbounded_Stream_Type;
      c    : Stream_Cursor_Type
      ) return Stream_Cursor_Type
   is
   begin
      if c = Null_Stream_Cursor then
         return c;
      end if;
      if c.Index =  this.F_Block_Size then
         return (c.Block + 1, 1);
      end if;
      return (c.Block, c.Index + 1);
   end Next;

   function Previous (
      this : Unbounded_Stream_Type;
      c    : Stream_Cursor_Type
      ) return Stream_Cursor_Type
   is
   begin
      if c.Block = 0 then
         return Null_Stream_Cursor;
      end if;
      if c.Index = 1 then
         return (c.Block - 1, this.F_Block_Size);
      end if;
      return (c.Block, c.Index - 1);
   end Previous;

   function Position (
      this : Unbounded_Stream_Type;
      c    : Stream_Cursor_Type
      ) return Stream_Element_Offset
   is
      pragma Inline(Position);
   begin
      if c.Block <= 0 then
         return 0;
      else
         return (c.Block - 1) * this.F_Block_Size + c.Index;
      end if;
   end Position;

   procedure Clear (this : in out Unbounded_Stream_type)
   is
   begin
      for p of this.F_Blocks loop
         Free(p);
      end loop;
      this.F_Blocks.Clear; 
      this.Clear_Data;
   end Clear;

   function First (
      this : Unbounded_Stream_Type
      ) return Stream_Cursor_Type
   is
      pragma Inline (First);
   begin
      return (this.F_Blocks.First_Index, 1);
   end First;

   function Last (
      this : Unbounded_Stream_Type
      ) return Stream_Cursor_Type
   is
      pragma Inline(Last);
   begin
      if this.F_Blocks.Is_Empty then
         return Null_Stream_Cursor;
      else
         return (this.F_Blocks.Last_Index, this.F_Block_Size);
      end if;
   end Last;

   procedure Reset_For_Read (this : in out Unbounded_Stream_type)
   is
      pragma Inline (Reset_For_Read);
   begin
      this.F_Read_Index := this.First;
   end Reset_For_Read;

   procedure Reset_For_Write (this : in out Unbounded_Stream_type)
   is
      pragma Inline (Reset_For_Write);
   begin
      this.F_Write_Index := this.First;
   end Reset_For_Write;

   procedure Clear_Data (this : in out Unbounded_Stream_Type)
   is
      pragma Inline (Clear_Data);
   begin
      this.F_Data_Last := Null_Stream_Cursor;
      this.Reset_For_Read;
      this.Reset_For_Write;
      this.F_Length := 0;
   end Clear_Data;

   function End_Of_Data (
      this   : in out Unbounded_Stream_Type;
      Cursor : Stream_Cursor_Type
      ) return Boolean
   is
      pragma Inline (End_Of_Data);
   begin
      return this.F_Data_Last < Cursor;
   end End_Of_Data;

   function End_Of_List (
      this : in out Unbounded_Stream_Type;
      Cursor : Stream_Cursor_Type
      ) return Boolean
   is
      pragma Inline (End_Of_List);
   begin
      return this.Last < Cursor; 
   end End_Of_List;

   procedure Read (
      this : in out Unbounded_Stream_type;
      Item : out Stream_Element_Array;
      Last : out Stream_Element_Offset
      )
   is
      type Read_States is (Completed, Incompleted);
      c  : Stream_Cursor_Type renames this.F_Read_Index;
      m  : Stream_Cursor_Type renames this.F_Data_Last;
      to : Stream_Element_Offset;
      s  : Read_States := Incompleted;


      procedure Copy (
         src : Stream_Element_Array;
         dst : in out Stream_Element_Array
         ) 
      is
      begin
         if src'Length < dst'Length then
            dst(dst'First .. dst'First + src'Length - 1) := src;
            Last := dst'First + src'Length - 1; 
            c.Index := src'Last;
         else
            dst := src(src'First .. src'First + dst'Length - 1);
            Last := dst'Last;
            c.Index := src'First + dst'Length - 1;
            s := Completed;
         end if;
      end Copy;
   begin
      Last := Item'First - 1;
      while (s = Incompleted) and then not this.End_Of_Data(c) loop
         to := (if c.Block = m.Block then m.Index else this.F_Block_Size);
         Copy(
            src => this.F_Blocks(c.Block).Data(c.Index .. to), 
            dst => Item(Last + 1 .. Item'Last));
         c := this.Next(c);
      end loop;
   end Read;

   procedure Write ( 
      this : in out Unbounded_Stream_type;
      Item : Stream_Element_Array 
      )
   is
      type Copy_State is (Completed, Incompleted);
      s : Copy_State := Incompleted;
      c : Stream_Cursor_Type renames this.F_Write_Index;
      from : Stream_Element_Offset := Item'First;

      procedure Copy (
         Src : Stream_Element_Array;
         Dst : in out Stream_Element_Array
         )
      is
      begin
         if Src'Length > Dst'Length then
            Dst := Src(Src'First .. Src'First + Dst'Length - 1);
            from := Src'First + Dst'Length;
            c.Index := Dst'Last;
         else
            Dst(Dst'First .. Dst'First + Src'Length- 1) := Src;
            from := Src'Last + 1;
            c.Index := Dst'First + Src'Length - 1;
            s := Completed;
         end if;
      end Copy;
   begin
      while s = Incompleted loop
         if this.End_Of_List(c) then
            this.Adjust_Capacity;
         end if;
         Copy(
            Src => Item(from .. Item'Last), 
            Dst => this.F_Blocks(c.Block).Data(c.Index .. this.F_Block_Size));
         c := this.Next(c);
      end loop;
      this.Update_Length;
   end Write;

   procedure Adjust_Capacity (this : in out Unbounded_Stream_Type)
   is
      b : Block_Pointer := new Block_Type(this.F_Block_Size);
      f : Boolean := this.F_Blocks.Is_Empty;
   begin
      this.F_Blocks.Append(b);
      if f then
         this.Clear_Data;
      end if;
   end Adjust_Capacity;

   procedure Update_Length (this : in out Unbounded_Stream_Type)
   is
      p : Stream_Cursor_Type := this.Previous(this.F_Write_Index);
   begin
      if this.F_Data_Last < p then
         this.F_Data_Last := p;
         this.F_Length := this.Position(p);
      end if;
   end Update_Length;

   function Read_Position (
      this : Unbounded_Stream_Type 
      ) return Stream_Element_Offset
   is
      pragma Inline (Read_Position);
   begin
      return this.Position(this.F_Read_Index);
   end Read_Position;

   function Write_Position (
      this : Unbounded_Stream_Type 
      ) return Stream_Element_Offset
   is
      pragma Inline (Write_Position);
   begin
      return this.Position(this.F_Write_Index);
   end Write_Position;

   procedure Set_Read_Position (
      this     : in out Unbounded_Stream_Type;
      Position : Stream_Element_Offset
      )
   is
      pragma Inline(Set_Read_Position);
   begin
      if Position in 1 .. this.Length + 1 then
         this.F_Read_Index := (
            Block => Position / this.F_Block_Size + 1, 
            Index => Position mod this.F_Block_Size + 1);
      else
         raise Constraint_Error with "Out of range";
      end if;
   end Set_Read_Position;

   procedure Set_Write_Position (
      this     : in out Unbounded_Stream_Type;
      Position : Stream_Element_Offset
      )
   is
      pragma Inline(Set_Write_Position);
   begin
      if Position in 1 .. this.Capacity + 1 then
         this.F_Write_Index := (
            Block => Position / this.F_Block_Size + 1, 
            Index => Position mod this.F_Block_Size + 1);
      else
         raise Constraint_Error with "Out of range";
      end if;
   end Set_Write_Position;

   function Capacity (
      this : Unbounded_Stream_Type
      ) return Stream_Element_Count
   is
      pragma Inline (Capacity);
   begin
      return Stream_Element_Count(this.F_Blocks.Length) * this.F_Block_Size;
   end Capacity;

   procedure Finalize (this : in out Unbounded_Destructor_Type)
   is
   begin
      this.Owner.Clear;
   end Finalize;

end Storage_Streams.Unbounded;

